Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/lisp/eulisp/mpfeel.lha/MPFeel/Plurals/Modules/ppl.em

Lisp/Scheme | 1992-07-02 | 26KB | 873 lines

;
;       Proper Paralation Lisp
;
;       File            : ppl
;
;       Contents        : export list:    elwise
;                    match
;                    move
;                    depfun
;                    choose
;                    enum
;                    count
;                    position
;                    get
;                    field-ref (+ setter)
;                    field-length
;                    make-paralation
;                    fieldp
;
;       Description     : So called proper paralation lisp because it run
;              on the processor array. This is better than the last
;              version (plisp) as the underlying system is able
;              to allocate processors in rectangles. So perhaps this
;              should be bpl (better paralation lisp). This code
;              rewires the given elwise form into a (hefty) piece
;              of singular code with calls to parallel
;              primitives.
;
;       Author          : SCM
;
;       Change History  :
;
;       Date    Name    Comment
;     02:06:92  SCM     Created - hacked from plisp.emc
;     17:06:92  SCM    Added attributes slot and modified get


; Include Files
; ======= =====

; This file has to be run through a preprocessor (empp, uses cpp and sed)
; to create  a EuLisp readable file. This is because it needs access to
; constants used by the data parallel lisp primitives written in mpl. The
; constants distinguish the various lisp types and the types of binary,
; unary and relational operators available.




















































































































(defmodule ppl (standard0 plural ppl-ll) ()


; System Configuration
; ====== =============

; These constants are system defined, the first three indicate the number of
; physical processors available, GC-TOP varies with the size of heap.

  (setq MP-Config 512)
  (setq MP-X-Config 16)
  (setq MP-Y-Config 32)
  (setq GC-TOP (mp-sb-ref))


; Debug
; =====

; xecs are a hangover from eubang (the plurals module) and the connection
; machine lisp module which was experimentally developed before plisp,
; it is included here purely for debug purposes as it is the most
; primitive way of looking at parallel objects, which can be useful
; when something has gone wrong.

  (defclass xec ()
    ((context
      initarg context
      reader  context)
     (offset
      initarg offset
      reader  offset))
    constructor (allocate-xec context offset)
    predicate xecp)

  (defun make-xec (c o)
    (become-strange (allocate-xec c o)))

  (defmethod generic-prin ((p xec) str)
    (format str "#x(")
    (mp-print (context p) (offset p) () () str)
    (format str ")")
    p)

  (defmethod generic-write ((p xec) str)
    (format str "#x(")
    (mp-print (context p) (offset p) () () str)
    (format str ")")
    p)


; Paralation Structure
; ========== =========

; The paralation is a handle on the set of processor you are working
; on, it contains all sorts of useful information, like how many
; there are, if they have any shape.
; Fields, the data parallel objects in paralation lisp, all belong to
; one (and only one) paralation, hence they have pointer to their
; paralation structure. A special field, called the index field and
; enumerates the elements of the paralation is associated with the
; paralation and so we have a pointer to this field in the paralation
; structure as well.
;    We now have the extra slot, attributes, which can be used to
; store useful information about the paralation, for example in the
; case of a rectangle its dimensions (in contexts!).

  (defclass paralation-internal ()
    ((contexts
      initarg contexts
      reader contexts-internal)
    (index
     initarg index
     accessor index-internal)
    (shape
     initarg shape
     accessor shape-internal)
    (attributes
     initarg attributes
     accessor attributes)
    (length
     initarg length
     reader length-internal))
    constructor (allocate-paralation contexts length))


; Paralation Object Structure
; ========== ====== =========

; Paralation objects, anything that require a paralation to make any
; sense, namely a field or a mapping, which describe communication
; patterns between fields. These all contain a paralation and a list
; of offsets into the data parallel heaps which is where the actual
; data is.

  (defclass paralation-object ()
    ((paralation
      initarg paralation
      reader paralation)
    (offsets
     initarg offsets
     accessor offsets))
    predicate paralation-object-p)


; Field Structure
; ===== =========

; First we deal with fields. Notice that we wrap the field allocator
; with a form which marks the structure as being strange, this is so
; the GCer can spot tyhem and list them so we can tell the MasPar
; which of it's objects are still around.

  (defclass field (paralation-object)
    ()
    constructor (allocate-field paralation offsets)
    predicate fieldp)

  (defun make-field (p o)
    (become-strange (allocate-field p o)))

; The paralation contains the data we are interested in, but in
; general we have the field structures, so here are functions to get
; the appropriate values from a field structure.

  (defun contexts (p-o) (contexts-internal (paralation p-o)))

  (defun index (p-o) (index-internal (paralation p-o)))

  (defun shape (p-o) (shape-internal (paralation p-o)))

  ((setter setter) shape (lambda (f v)
   ((setter shape-internal) (paralation f) v)))

  (defun field-length (p-o) (length-internal (paralation p-o)))

; Notice how these methods use a combination of immediate and indirect
; accessors, anyway - now we can print them.

  (defmethod generic-prin ((f field) str)
    (if (not (attributes (paralation f)))
      (progn
    (format str "#F(")
    (mp-print (car (contexts f)) (car (offsets f)) () () str)
    (if (cdr (contexts f)) (format str "... )") (format str ")")))
      (let ((context-width (min (vector-ref (attributes (paralation f)) 0) MP-X-Config)))
    (format str "\n#F(")
    (mp-print (car (contexts f)) (car (offsets f)) context-width
          (< context-width (vector-ref (attributes (paralation f)) 0)) str)
    (if (< MP-Y-Config (vector-ref (attributes (paralation f)) 1))
      (format str "\n ... )") (format str " )")))))

  (defmethod generic-write ((f field) str)
    (if (not (attributes (paralation f)))
      (progn
    (format str "#F(")
    (mp-print (car (contexts f)) (car (offsets f)) () () str)
    (if (cdr (contexts f)) (format str "... )") (format str ")")))
      (let ((context-width (min (vector-ref (attributes (paralation f)) 0) MP-X-Config)))
    (format str "\n#F(")
    (mp-print (car (contexts f)) (car (offsets f)) context-width
          (< context-width (vector-ref (attributes (paralation f)) 0)) str)
    (if (< MP-Y-Config (vector-ref (attributes (paralation f)) 1))
      (format str "\n   ... )") (format str " )")))))

;  (defmethod generic-prin ((f field) str)
;    (format str "#F(")
;    (mapcar (lambda (c o) (mp-print c o () () str)) (contexts f) (offsets f))
;    (format str ")")
;    f)
;
;  (defmethod generic-write ((f field) str)
;    (format str "#F(")
;    (mapcar (lambda (c o) (mp-print c o () () str)) (contexts f) (offsets f))
;    (format str ")")
;    f)


; Processor Management
; ========= ==========

; Paralation Lisp abstracts the number of processors, it does this by
; having a list of contexts on which the paralation is allocated, data
; parallel operations are run on each of these one after another.
; A context will be a collection of global contexts, that is ones that
; use the entire array and one that uses only part of the array. We
; reuse the same global context and pre-allocate it.

  (setq MP-Context (mp-make-context MP-X-Config MP-Y-Config))


  (setq MP-Offsets (cons (mp-scan-op MP-Context (mp-set MP-Context
                            (mp-bang MP-Context 1)
                            0 0)
                         610) ()))

  (setq MP-Nil (mp-bang MP-Context ()))

; This will ensure the global context is garbage collected as we have
; nailed it into the environment in a form that can be spotted by the
; collector.

  (setq GC-Protect (list (make-xec MP-Context (car MP-Offsets))
             (make-xec MP-Context MP-Nil)))

; As we allocate large paralations we reuse exisiting indexes for the
; global context compontents, the two variables below are useful for
; keeping track of these things and manipulating them in parallel

  (setq VMP-Config MP-Config)
  (setq PMP-Config (mp-bang MP-Context MP-Config))

  (setq GC-Protect (cons (make-xec MP-Context PMP-Config) GC-Protect))

; As more virtual pes are allocated we need to number them, we reuse
; the enumerations of the global contexts as they are the same for all
; paralations and are immutable. Each time another gklobal context is
; needed produce an enumeration for it (m -> m + config -1)

  (defun enough-virtual-pes-p
    ;; determines wether more enumerations of the global context are needed
    (required) (< required (+ VMP-Config MP-Config)))

  (defun more-processors (required)
    ;; if needed allocates more enumerations of the global context
    (labels ((find-last (offsets)
           ;; descends list of enumerations to the last cons cell
           ;; extra enumerations are then tagged onto the list
           (if (cdr offsets) (find-last (cdr offsets))
         ((setter cdr) offsets (make-rest (car offsets)))))
             (make-rest (offset)
           ;; creates list of as many other enumeration nodes as required
           ;; and GC protects them
           (if (enough-virtual-pes-p required) ()
         (let ((new-ofst (mp-bin-op MP-Context offset
                        PMP-Config     610)))
           (setq VMP-Config (+ VMP-Config MP-Config))
           (setq GC-Protect (cons (make-xec MP-Context new-ofst)
                      GC-Protect))
           (cons new-ofst (make-rest new-ofst))))))
      (find-last MP-Offsets)))

  (defun make-hacked-context (size)
    (if (= size 1) (mp-make-context 1 1)
      (let* ((width (ceiling (sqrt (/ size 2))))
         (ctxt (mp-make-context width (ceiling (/ (* 1.0 size) width))))
         (ofst (mp-context ctxt))
         (tmp-pspace (mp-ps-ref))
         (dummy (mp-sb-set tmp-pspace))
         (enum (mp-scan-op ctxt (mp-bang ctxt 1)     610)))
    (mp-if ctxt (mp-rel-op ctxt enum (mp-bang ctxt size)     652))
    (mp-else ctxt)
    (mp-assign ctxt ofst (mp-bang ctxt '(() ())))
    (mp-fi ctxt)
    (mp-ps-set tmp-pspace)
    (mp-sb-set GC-TOP)
    ctxt)))

  (defun get-contexts (required)
    ;; allocates contexts for a new paralation, creates new global
    ;; contexts if needed and probably one partial context unigue to
    ;; this paralation
    (if (not (enough-virtual-pes-p required)) (more-processors required) ())
    (labels ((list-of-ctxts (allocated)
           ;; generates the appropriate list of contexts
               (if (>= (+ allocated MP-Config) required)
         (list (make-hacked-context (- required allocated)))
         (cons MP-Context (list-of-ctxts (+ allocated MP-Config))))))
      (list-of-ctxts 0)))

  (defun number-segment (ctxt ofst start)
    (mp-assign ctxt ofst (mp-bang ctxt 1))
    (mp-set ctxt ofst 0 start)
    (mp-assign ctxt ofst (mp-scan-op ctxt ofst     610)))

  (defun get-offsets (contexts)
    ;; allocates enumeration offsets for the new paralation with the
    ;; given contexts, the global context enumerations are pulled from
    ;; teh list of shared enumerations, a sopecial enumeration is
    ;; allocated for the straggly bit at the end. get-contexts will
    ;; have alloacted the extra virtual processors if needed
    (labels ((list-of-ofsts (contexts offsets allocated)
           ;; generate the appropriate list of offsets
           (cond
        ((null contexts) ())
        ((eq (car contexts) MP-Context)
         (cons (car offsets)
               (list-of-ofsts (cdr contexts) (cdr offsets)
                      (+ allocated MP-Config))))
        (t (list (number-segment (car contexts)
                     (mp-make-plural (car contexts))
                     allocated))))))
      (list-of-ofsts contexts MP-Offsets 0)))

  (defcondition illegal-operation ())

; Creating a paralation means create the index field for a new
; paralation which is what we do here.

  (defun make-paralation (size)
    (if (< size 1) (error "Cannot create empty paralation" illegal-operation)
      (let ((new-field (make-field (allocate-paralation (get-contexts size)
                            size) 'no-offsets)))
    ((setter offsets) new-field (get-offsets (contexts new-field)))
    ((setter index-internal) (paralation new-field) new-field)
    new-field)))


; Obvious operations
; ======= ==========

  (defun field-ref (f i)
    (let ((list-index (/ i MP-Config)))
      (mp-ref (list-ref (contexts f) list-index)
          (list-ref (offsets f) list-index) (remainder i MP-Config))))

  ((setter setter) field-ref (lambda (f i v)
     (let ((list-index (/ i MP-Config)))
       (mp-set (list-ref (contexts f) list-index)
           (list-ref (offsets f) list-index) (remainder i MP-Config) v)
       f)))

; And field-length is now a slot accessor!


; Operation Overview
; ========= ========

; Because the same piece of parallel code will have to run on several
; different contexts the code generated references a global called
; The-Context, mapping the code across the contexts with the first
; operation being Set-The-Context will neatly allow us to do this

; Primitives
; ==========

; These are the operations which wrap all the functions in the plural
; module which is implemenmted in C and mpl, the parallel versions of
; the functions are generated by macros which can be found in ppl-ll.em

  (p-1-fn mp-un-op negate       620)
  (p-1-fn mp-un-op abs     621)
  (p-2-fn mp-eq eq ())
  (p-2-fn mp-cons cons ())
  (p-1-fn mp-car car ())
  (p-1-fn mp-cdr cdr ())
  (p-1-fn mp-make-vector make-vector())
  (p-1-fn mp-vector-length vector-length ())
  (p-2-fn mp-vector-ref vector-ref ())
  (p-1-fn mp-test consp 2)
  (p-1-fn mp-test intp 1)
  (p-1-fn mp-test floatp 4)
  (p-1-fn mp-test vectorp 3)
  (p-2-fn mp-bin-op binary-plus     610)
  (p-2-fn mp-bin-op +     610)
  (p-2-fn mp-bin-op binary-difference 611)
  (p-2-fn mp-bin-op - 611)
  (p-2-fn mp-bin-op binary-times 613)
  (p-2-fn mp-bin-op * 613)
  (p-2-fn mp-bin-op binary-divide 612)
  (p-2-fn mp-bin-op / 612)
  (p-2-fn mp-rel-op binary-gt     651)
  (p-2-fn mp-rel-op >     651)
  (p-2-fn mp-rel-op binary-lt     650)
  (p-2-fn mp-rel-op <     650)
  (p-2-fn mp-bin-op remainder 614)
  (p-0-fn mp-random c-rand ())
  (p-2-fn mp-and and ())
  (p-2-fn mp-or or ())
  (p-1-fn mp-not not ())

  (p-2-fn mp-assign setq ())

  (p-3-set mp-vector-set vector-ref ())
  (p-2-set mp-rplac-a car ())
  (p-2-set mp-rplac-d cdr ())

; There are a few lisp functions who work in parallel - this is a hack!

  ((setter table-ref) pfun-table 'progn (cons 'progn ()))


; Elwise
; ======

; The-Context hackery, global binding and a function to set it so that
; this can be exported.

  (setq The-Context 'none)

  (defun Set-The-Context (v) (setq The-Context v))

; The heart of the rewriting operation, pull the appropriate functions
; out og the pfun-tables, bangs singular values with special hackery
; for cond, let, lambda and if.

  (defun rewire (form)
    (cond
     ((consp form)
      (cond
       ((eq (car form) 'quote) (list 'mp-bang 'The-Context form))
       ((eq (car form) (car function-name)) (cons (cadr function-name)
                          (rewire (cdr form))))
       ((eq (car form) 'if) (elwise-if (cadr form) (caddr form) (cadddr form)))
       ((eq (car form) 'setter) (car (get-psetter (cadr form))))
       ((eq (car form) 'cond) (cons 'let (cons '((cond-result
                        (mp-make-plural The-Context)))
                    (cons '(mp-if The-Context (mp-bang The-Context t))
                      (rewire-cond (cdr form))))))
       ((eq (car form) 'lambda) (rewire-lambda (cdr form)))
       ((eq (car form) 'let) (rewire-let (cdr form)))
       (t (cons (if (car form) (rewire (car form)) MP-Nil)
        (rewire (cdr form))))))
     ((numberp form) (list 'mp-bang 'The-Context form))
     ((memq form arg-list) form)
     ((get-pfun form) (car (get-pfun form)))
     ((null form) ())
     (t (list 'mp-bang 'The-Context form))))

  (defun rewire-cond (form)
    (if (null form) '((mp-fi The-Context) cond-result)
      (cons
       (list 'if (list 'mp-if 'The-Context (rewire (caar form)))
         (list 'mp-assign 'The-Context
           'cond-result(rewire (cadar form))) ())
       (cons '(mp-file The-Context)
         (rewire-cond (cdr form))))))

  (defun rewire-let (form)
    (let ((old-arg-list arg-list))
      (setq arg-list (append (mapcar car (car form)) arg-list))
      (let ((r-form (list 'let (mapcar (lambda (n-f-p)
                     (cons (car n-f-p)
                           (rewire (cdr n-f-p))))
                       (car form)) (cons 'progn (mapcar rewire
                               (cdr form))))))
    (setq arg-list old-arg-list)
    r-form)))

  (defun rewire-lambda (form)
    (let ((old-arg-list arg-list))
      (setq arg-list (append (car form) arg-list))
      (let ((r-form (list 'lambda (car form) (rewire (cadr form)))))
    (setq arg-list old-arg-list)
    r-form)))

  (defun elwise-if (bool then else)
    (let ((then (if then (rewire then) MP-Nil))
      (else (if else (rewire else) MP-Nil)))
      (list 'let '((if-result (mp-make-plural The-Context)))
        (list 'if (list 'mp-if 'The-Context (rewire bool))
          (list 'mp-assign 'The-Context 'if-result then) ())
        (list 'if (list 'mp-else 'The-Context)
          (list 'mp-assign 'The-Context 'if-result else) ())
        '(mp-fi The-Context)
        'if-result)))

; This function is responsible for creating the code which sets
; everything up before the parallel code is ionvoked, creates bindings
; to offsets into the data parallel heap rather than front-end
; structures, code to evaluate any let forms in the elwise parameter
; list and extracts the book-keeping info (namely the paralation
; structure) from one of the parameter fields.
; It also sets up the arg-list, that is the list of parameter field
; which are kept in a globally accessible place so we can spot when we
; don't need to bang something.

  (defun eval-arg-list (arg-form)
    (if (null arg-form)
      (list (list 'the-contexts (list 'contexts (car arg-list)))
        (list 'the-paralation (list 'paralation (car arg-list)))
        '(the-offsets (mapcar mp-make-plural the-contexts))
        '(the-result (make-field the-paralation the-offsets)))
      (if (consp (car arg-form))
        (progn
          (setq arg-list (cons (caar arg-form) arg-list))
          (cons (car arg-form) (eval-arg-list (cdr arg-form))))
        (progn
          (setq arg-list (cons (car arg-form) arg-list))
          (eval-arg-list (cdr arg-form))))))

  (defun extract-offsets (arg-list)
    ;; gets the offset lists from each of the elwise parameter fields,
    ;; these oo are spliced into the rewritten code.
    (mapcar (lambda (f) (list `offsets f)) arg-list))

  (defmacro elwise (arg-form body)
    ;; And this is the hoopty-hoopty-doo-do macro itself which puts
    ;; all the bits in the write place.
    (setq arg-list ())
    (setq function-name '(none))
    `(let* ,(eval-arg-list arg-form)
       (mapcar (lambda ,(cons `the-context
                  (cons 'result-ofst arg-list))
         (let ((tmp-pspace (mp-ps-ref)))
           (mp-sb-set tmp-pspace)
           (Set-The-Context the-context)
           (mp-assign The-Context result-ofst
                  ,(if body (rewire body)
                 (list 'mp-bang 'The-Context ())))
           (mp-sb-set GC-TOP)
           (mp-ps-set tmp-pspace)
           result-ofst))
           ,@(cons `the-contexts (cons `the-offsets
                       (extract-offsets arg-list))))
       the-result))

; to add primitives, particularly recursive primitives

  (defmacro depfun (name args body)
    (setq arg-list args)
    (setq function-name (list name (make-pfun-name name)))
    (add-pfun name (cadr function-name) args)
    `(progn (defun ,(cadr function-name) ,args ,(rewire body))
        (export ,(cadr function-name))))


; Mappings
; ========

; Mappings describe communication bewteen paralations. They are a
; special kind of plural. Without virtualisation they are easy to
; understand. Each element of the paralation contains a list of
; processor numbers which an object should be taken from. In the
; virtualisation we have to handle the mxn combinations of contexts,
; hence rather than a list of offsets, we have a list of lists of
; offsets , which gives us all the informationwe need.

  (defclass mapping (paralation-object)
    ()
    constructor (make-mapping paralation offsets)
    predicate mappingp)

  (defun allocate-mapping (p o)
    (become-strange (make-mapping p o)))


; Communications
; ==============

; Strictly speaking anything which isn't elwise I guess

; Match
; =====

; This is indeed a most nasty operation, zipping along lists of
; contexts and offsets at slightly different rates, not turning down a
; cdr, suddenly dropping dead of myxamatosis!

  (defun match (dest from)
    (let ((result (allocate-mapping
           (paralation dest)
           (mapcar (lambda (d-c) (mapcar (lambda (f-c)
                           (mp-make-plural d-c))
                         (contexts from)))
               (contexts dest))))
           (tmp-pspace (mp-ps-ref)))
      (mp-sb-set tmp-pspace)
      (labels ((seg-match (d-ctxt d-ofst r-ofsts ctxts ofsts)
             (if (null ctxts) ()
           (progn
             (mp-assign d-ctxt (car r-ofsts)
                  (mp-match d-ctxt d-ofst (car ctxts) (car ofsts)))
             (seg-match d-ctxt d-ofst (cdr r-ofsts)
                (cdr ctxts) (cdr ofsts))))))
    (mapcar (lambda (c o r)
          (seg-match c o r (contexts from) (offsets from)))
        (contexts dest) (offsets dest) (offsets result))
    (mp-ps-set tmp-pspace)
    (mp-sb-set GC-TOP)
    result)))

; Move, several levels of move so that get and choose etc can make use
; of the appropriate bits.

  (defun ll-move (data map initial)
    ;; low-level move operation,
    (mapcar
     (lambda (m-ctxt m-ofsts i-ofst)
       (mapcar (lambda (d-ctxt d-ofst m-ofst)
         (mp-move d-ctxt d-ofst m-ctxt m-ofst i-ofst))
           (contexts data) (offsets data) m-ofsts))
     (contexts map) (offsets map) (offsets initial))
    (offsets initial))

; The real meat of the operation, exceptionally nasty as this is what
; handles the nxm combinations between two virtual sets of
; communicating processors

  (defun l-move (data map p-with default)
    (labels ((recurse (l-ofst cdrl-ofst)
           (if (not (mp-if The-Context cdrl-ofst)) ()
         (mp-assign The-Context l-ofst
                (p-with (mp-car The-Context l-ofst)
                    (recurse cdrl-ofst
                         (mp-cdr The-Context cdrl-ofst)))))
           (mp-else The-Context)
           (mp-assign The-Context l-ofst (mp-car The-Context l-ofst))
           (mp-fi The-Context)
           l-ofst))
      (let ((result (make-field (paralation map)
                (mapcar mp-make-plural (contexts map))))
         (tmp-pspace (mp-ps-ref)))
    (mp-sb-set tmp-pspace)
    (mapcar (lambda (ctxt ofst)
          (mp-ps-set tmp-pspace)
          (Set-The-Context ctxt)
          (mp-if ctxt ofst)
          (recurse ofst (mp-cdr The-Context ofst))
          (mp-else ctxt)
          (mp-assign ctxt ofst (mp-bang ctxt default))
          (mp-fi ctxt)
          ofst)
        (contexts map) (ll-move data map result))
    (mp-ps-set tmp-pspace)
    result)))

  (defmacro move (data map with default)
    `(l-move ,data ,map ,(rewire with) ,default))

; Shaped paralations.
; ====== ===========

;    A shaped paralation has a predefined set of mappings which
; specify the neighbours of each element, get can be thought of as
; "each element takes it's value from the element in the given
; direction", the mappings are held in a vector in the shape slot of
; the paralation, and are extracted by the given token, e.g. N = 0.
;    We need to extend this to support shapes which do not use
; mappings, for examle rectangles making use of the nearest neighbour
; communication network of the underlying architecture. To do this we
; simply place the functions which do the move and apply this to the
; field.

  (defun get (direction f default)
    (let* ((map (vector-ref (shape f) direction))
      (result (if (not (mappingp map)) (elwise (f) f)
            (make-field (paralation f) (mapcar mp-make-plural
                               (contexts f)))))
      (tmp-pspace (mp-ps-ref)))
      (mapcar (lambda (c o)
        (mp-sb-set tmp-pspace)
        (mp-if c o) (mp-assign c o (mp-car c o))
        (mp-else c) (mp-assign c o (mp-bang c default))
        (mp-fi c)
        (mp-ps-set tmp-pspace)
        o)
          (contexts f) (if (mappingp map) (ll-move f map result) (map result)))
      (mp-sb-set GC-TOP)
      result))

  (defun enum-ll (bool-f)
    (let ((result (elwise (bool-f) (if bool-f 1 0)))
      (tmp-pspace (mp-ps-ref)))
      (labels ((recurse (c-s o-s s)
         (mp-assign (car c-s) (car o-s)
                (mp-bin-op (car c-s)
                       (mp-scan-op (car c-s)
                           (car o-s)     610)
                       (mp-bang (car c-s) s)     610))
         (if (null (cdr c-s)) ()
           (recurse (cdr c-s) (cdr o-s)
                (mp-ref (car c-s) (car o-s) (- MP-Config 1))))))
      (mp-sb-set tmp-pspace)
      (recurse (contexts result) (offsets result) 0)
      (mp-ps-set tmp-pspace)
      (mp-sb-set GC-TOP)
      result)))

  (defun enum (bool-f)
    (elwise (bool-f (new (enum-ll bool-f))) (if bool-f (- new 1) ())))

  (defun choose (bool-f)
    (let ((tmp (enum-ll bool-f)))
      (match (make-paralation (field-ref tmp (- (field-length bool-f) 1)))
         (elwise (tmp bool-f) (if bool-f (- tmp 1) ())))))

  (defun count (bool-f)
    (field-ref (enum-ll bool-f) (- (field-length bool-f) 1)))

  (defun position (f o)
    (let* ((tmp (elwise (f (i (index f))) (if (eq f o) i ())))
       (tmp-pspace (mp-ps-ref))
       (t-o (progn (mp-sb-set tmp-pspace) (mp-bang MP-Context 32768))))
      (labels ((recurse (c-s o-s last)
         (cond
          ((null c-s) ())
          ((not (mp-if (car c-s) (car o-s)))
           (progn (mp-fi (car c-s))
              (recurse (cdr c-s) (cdr o-s) (- last MP-Config))))
          (t (progn
               (mp-assign (car c-s) t-o (car o-s))
               (mp-fi (car c-s))
               (mp-ref (car c-s) (mp-scan-op (car c-s) t-o     661)
                   (if (>= last MP-Config) (- MP-Config 1)
                 (- last 1))))))))
        (let ((result (recurse (contexts f) (offsets tmp) (field-length f))))
      (mp-sb-set GC-TOP)
      (mp-ps-set tmp-pspace)
      result))))

(export depfun elwise match move make-paralation field-ref contexts offsets
        index shape make-field Set-The-Context The-Context GC-TOP position
    l-move choose enum count get fieldp field-length paralation
    allocate-xec allocate-paralation index-internal rewire
    shape-internal attributes paralation-internal
    MP-Config MP-X-Config MP-Y-Config)


)